Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/memory/drivers/drivers.pas

Pascal/Delphi Source File | 1995-04-10 | 32.3 KB | 1,317 lines

UNIT Drivers;

{
  DRIVERS.PAS - Version 1.00 - By R.A.J. van Eeghem, (C) 1995

  date        : April, 1995
  contents    : mouse-driver, EMS-driver (3.0), XMS-driver (3.0)
  language    : Borland/Turbo Pascal 6.0 (or higher)
  autor        : R.A.J. van Eeghem, Netherlands
  e-mail    : [e-mail]
}

{
  Copyright/Permissions:

  You are allowed to use this any or all parts of this code for youre own
  benefits, provided you do not modify it and/or sell it. Furthermore I'd
  appreciate it if you put my name into youre credits-list.

  Disclaimer:

  Note that I'll not take responsibility for any damage caused by using
  this code. It's the users sole responsibility to test this code for his
  or her purposes.

  Credits:

  My thanks goes to the people of Borland for designing the language
  Borland/Turbo Pascal.
}

{
  Mouse Driver:

  The mouse driver provides a set of API-routines to communicate with a
  mousedriver, loaded at startup. To use them, the user must first call
  InitMouse. This procedure will initialize some of the global variable.
  The user can then check the global boolean MouseAvail to see wether a
  mouse is available. After using the mouse-driver, driver will be reset
  to it's original state.

  routine        what it does

  InitMouse        initializes the mouse driver API
  DoneMouse        deinitializes the mouse driver API

  ShowMouse        make mouse pointer visible
  HideMouse        make mouse pointer hidden
  LocateMouse        locate mouse pointer a position (x,y)

  GetMouseInfo        get current status of mouse
  GetMousePressInfo    get button press information
  GetMouseReleaseInfo    get button release information

  SetLimits        limit area of mouse pointer
  SetGraphPointer    set alternate mouse pointer (graphics mode only)

  SetUserEventHandler    set user-defined event handler
  SwapUserEventHandler    swap user-defined event handler
}

{
  EMS Driver:

  The EMS-driver provides acces to most of the LIM-EMS 3.0 API-functions.
  To use the EMS-driver, the user simply calls InitEMS wich will check
  for the existence of a EMS-driver. If a driver is available, it will
  set EMSAvail to TRUE. The user must then request the version number and
  check wether it is above 3.0 (this is usually true since EMS 4.0 dates
  1987 and by now all EMS-drivers are full 4.0 compliant). However only
  the 3.0 functions actually deal with allocating and freeing memory (up
  to 64 kB), wich is the usual stuff people want to do with it.

  Some internals about the use of EMS. To allocate memory, you simply
  call AllocEMS specifying the amount of kB you need. The memory can only
  be allocated in pages of 16 kB so we specify the number of pages instead
  of the actual memory in kB. As a result of the allocation we get a handle,
  wich is simply a 16-bit number identifying youre memory block (something
  like a pointer - but you cannot use it to acces memory directly).

  To acces the memory obtained we must first map the EMS-memory onto the
  physical accessible swaparea. This is done by MapEMS. Since the segment
  is 64 kB this means we can map 4 pages of EMS-memory (note: this does not
  mean the 4 pages of memory all have to belong to the same handle, we can
  map 4 pages of 4 different handles together in the swap-area, as long as
  they are physically separated).

  After using the memory we free it by calling FreeEMS. After that the
  handle becomes invalid and can no longer be used. Now one important thing:
  the EMS-driver is an external driver. So if you allocate memory but don't
  release it this memory will stay allocated until you reboot youre com-
  puter. This in contrast to DOS-memory (below 640 kB). This means that
  you'll need a critical errorhandler that releases all EMS before ter-
  minating youre program!!

  routine        what it does

  InitEMS        checks for the existence of an EMS-driver
  EMSGetVersion        returns version number of EMS-driver

  AllocEMS        allocates EMS-memory
  FreeEMS        frees allocated EMS-memory
  MapEMS        map's EMS into the DOS-accessible swap-area

  EMSGetFreePages    returns number of free pages available
  EMSGetHandlePages    returns number of allocated pages of a handle
}

{
  XMS Driver:

  The XMS Driver provides acces to a subset of the XMS 3.0 API-functions.
  To use this routine the user must first call InitXMS. This will set
  XMSAvail to TRUE if an XMS-driver is found. After that the user must
  verify that the XMS-driver is of version 3.0 or above.

  To allocate XMS the user can simply call AllocXMS. The XMS-driver will
  then return a handle wich from now on will identify the allocated memory
  (like a pointer - however it cannot be used to acces memory directly).

  To use the XMS-memory, the user can rely on RealToXMS for swapping data
  from real memory (below 640 kB) to XMS-memory and XMSToReal for the
  reverse process. An additional routine is provided for swapping from
  XMS->XMS (MoveXMS) however in real-mode programs (= normal DOS programs)
  this routine will hardly be of any use.

  After using the memory, the XMS-handle (and the XMS-memory belonging to
  it) should be freed by calling FreeXMS. On other option is to expand/
  reduce the size of the XMS-memory using ReAllocXMS. However, one special
  note must be added to this: the XMS-driver is an external program, so
  if you end youre program without releasing all used XMS-memory, the
  memory will be kept allocated (until you reboot youre computer). This
  means that you'll need a critical errorhandler that releases all XMS
  before terminating youre program!!

  routine        what it does

  InitXMS        checks for the existence of a XMS-driver
  XMSGetVersion        returns version number of the XMS-driver

  AllocXMS        allocates XMS-memory
  FreeXMS        frees allocated XMS-memory
  MoveXMS           moves XMS-memory around in XMS-memory
  ReAllocXMS        resizes the amount of XMS-memoyr for a given handle

  RealToXMS        swaps real-memory to XMS-memory
  XMSToReal        swaps XMS-memoyr to real-memory
}

INTERFACE

{
  ------------------------------------------------------------------------

        Declaration Mouse Driver

  ------------------------------------------------------------------------
}
CONST
  mouseNoError        = 0;
  mouseInsuffMemory    = 1;
  mouseNoMouseFound    = 2;

CONST
  mbLEFTBUTTON        = 1;
  mbRIGHTBUTTON        = 2;
  mbCENTERBUTTON    = 3;

CONST
  maskMOUSE_MOVE    = 1;
  maskLB_PRESSED     = 2;
  maskLB_RELEASED    = 4;
  maskRB_PRESSED    = 8;
  maskRB_RELEASED    = 16;
  maskCB_PRESSED    = 32;
  maskCB_RELEASED    = 64;

CONST
  MouseAvail        :BOOLEAN=FALSE;

TYPE
  MouseRecord        =RECORD
    x,y,button,count    :WORD;
  END;

TYPE
  UserEventHandler    =RECORD
    mask        :WORD;
    handler        :POINTER;
  END;

PROCEDURE    InitMouse;
PROCEDURE    DoneMouse;

PROCEDURE    ShowMouse;
PROCEDURE    HideMouse;
PROCEDURE    LocateMouse(x,y:WORD);

FUNCTION    GetMouseInfo(VAR m:MouseRecord):WORD;
FUNCTION    GetMousePressInfo(button:WORD; VAR m:MouseRecord):WORD;
FUNCTION    GetMouseReleaseInfo(button:WORD; VAR m:MouseRecord):WORD;

PROCEDURE    SetLimits(xtop,ytop,xbottom,ybottom:WORD);
PROCEDURE    SetGraphPointer(xhspot,yhspot:WORD; VAR imagebuffer);

PROCEDURE    SetUserEventHandler(VAR hUser:UserEventHandler);
PROCEDURE    SwapUserEventHandler(VAR hUser:UserEventHandler);

{
  ------------------------------------------------------------------------

        Declaration EMS Driver (EMS 3.0)

  ------------------------------------------------------------------------
}

CONST
  EMSAvail        :BOOLEAN=FALSE;
  EMSErrorCode        :BYTE=0;
  EMSPageFrameAdress    :POINTER=NIL;
  EMSTotalPages        :WORD=0;
  EMSFreePages        :WORD=0;

CONST
  EMSerror_NoError            = $00;
  EMSerror_EMSSoftwareInternalError     = $80;
  EMSerror_HardwareMailfunction        = $81;
  EMSerror_MemoryManagerBusy        = $82;
  EMSerror_InvalidHandle        = $83;
  EMSerror_FunctionNotDefined        = $84;
  EMSerror_NoMoreHandlesAvailable    = $85;
  EMSerror_MappingContextSaveLoadError    = $86;
  EMSerror_RequestExceedsSystemLimits    = $87;
  EMSerror_ReqeustExceedsFreeMemLimits    = $88;

PROCEDURE    InitEMS;
PROCEDURE    EMSGetVersion(VAR num,dec:BYTE);

FUNCTION    AllocEMS(VAR handle:WORD; numpages:WORD):BOOLEAN;
FUNCTION    FreeEMS(VAR handle:WORD):BOOLEAN;
FUNCTION    MapEMS(srcPage:WORD; destPage:BYTE; VAR handle:WORD):BOOLEAN;

FUNCTION    EMSGetFreePages:WORD;
FUNCTION    EMSGetHandlePages(VAR handle:WORD):WORD;

{
  ------------------------------------------------------------------------

        Declaration XMS Driver (XMS 3.0)

  ------------------------------------------------------------------------
}

CONST
  XMSAvail        :BOOLEAN=FALSE;
  XMSErrorCode        :BYTE=0;
  XMSFreeMemory        :WORD=0;
  XMSMaxBlock        :WORD=0;

CONST
  XMSerror_NoError            = $00;
  XMSerror_FunctionNotImplemented    = $80;
  XMSerror_VirtualDiskDetected        = $81;
  XMSerror_A20error            = $82;
  XMSerror_GeneralDriverError        = $8E;
  XMSerror_UnrecoverableDriverError    = $8F;
  XMSerror_HMADoesNotExist        = $90;
  XMSerror_HMAAlreadyInUse        = $91;
  XMSerror_DXLessThanHMAMINParameter    = $92;
  XMSerror_HMANotAllocated        = $93;
  XMSerror_A20StillEnabled        = $94;
  XMSerror_AllXMSAllocated        = $A0;
  XMSerror_OutOfXMSHandles        = $A1;
  XMSerror_InvalidHandle        = $A2;
  XMSerror_SourceHandleInvalid        = $A3;
  XMSerror_SourceOffsetInvalid        = $A4;
  XMSerror_DestHandleInvalid        = $A5;
  XMSerror_DestOffsetInvalid        = $A6;
  XMSerror_LengthInvalid        = $A7;
  XMSerror_MoveHasInvalidOverlap    = $A8;
  XMSerror_ParityError            = $A9;
  XMSerror_BlockIsNotLocked        = $AA;
  XMSerror_BlockIsLocked        = $AB;
  XMSerror_LockCountOverflow        = $AC;
  XMSerror_LockFail            = $AD;
  XMSerror_SmallerUMBAvailable        = $B0;
  XMSerror_NoUMBAvailable        = $B1;
  XMSerror_UMBSegmentNumberInvalid    = $B2;

TYPE
  XMSMoveStruct        =RECORD
    length        :LONGINT;
    hSource        :WORD;
    offsetSource    :LONGINT;
    hDest        :WORD;
    offsetDest        :LONGINT;
  END;

PROCEDURE    InitXMS;
PROCEDURE    XMSGetVersion(VAR num,dec:BYTE);

FUNCTION    AllocXMS(VAR handle:WORD; sizeKB:WORD):BOOLEAN;
FUNCTION    FreeXMS(VAR handle:WORD):BOOLEAN;
FUNCTION    MoveXMS(VAR mvData:XMSMoveStruct):BOOLEAN;
FUNCTION    ReAllocXMS(VAR handle:WORD; newsizeKB:WORD):BOOLEAN;

FUNCTION    XMSGetMaxBlock:WORD;
FUNCTION    XMSGetBlockSIze(VAR handle:WORD):WORD;

PROCEDURE    RealToXMS(VAR source; VAR hDest:WORD; ofs,cnt:LONGINT);
PROCEDURE       XMSToReal(VAR hSource:WORD; ofs:LONGINT; VAR dest; cnt:LONGINT);

IMPLEMENTATION

USES Dos;

{
  ------------------------------------------------------------------------

        Implementation Mouse Driver

  ------------------------------------------------------------------------
}
VAR
  _savestatebuffer    :POINTER;
  _savestatebuffersize    :WORD;
  _numberbuttons    :WORD;
  _errorcode        :WORD;

{
  procedure    : InitMouse
  parameters    : none
  result    : none

  Saves the current state of the mouse driver and initializes the mouse-
  driver again. This procedure will initialize the global variable
  MouseAvail.
}
PROCEDURE InitMouse;
VAR
  r            :REGISTERS;
BEGIN
  _errorcode:=mouseNoError;

  { initialize no mouse available }
  _savestatebuffersize:=0;
  _savestatebuffer:=NIL;

  { get mouse save state buffer size }
  r.ax:=$0015;
  intr($33,r);

  { check if memory can be allocated }
  IF ( maxavail<r.bx ) THEN
  BEGIN
    _errorcode:=mouseInsuffMemory; exit;
  END;

  { allocate memory for buffer }
  _savestatebuffersize:=r.bx;
  getmem(_savestatebuffer,_savestatebuffersize);

  { save mouse driver status }
  r.ax:=$0016;
  r.dx:=ofs(_savestatebuffer^);
  r.es:=seg(_savestatebuffer^);
  intr($33,r);

  { initialize mouse }
  r.ax:=$0000;
  intr($33,r);

  { if no mouse available }
  IF ( r.ax=$0000 ) THEN
  BEGIN
    _errorcode:=mouseNoMouseFound; exit;
  END;

  { store number of mouse-buttons }
  MouseAvail:=TRUE;
  _numberbuttons:=r.bx;
END;

{
  procedure    : DoneMouse
  parameters    : none
  result    : none

  Deinitializes the mouse-driver by reloading the previous status of the
  driver.
}
PROCEDURE DoneMouse;
VAR
  r            :REGISTERS;
BEGIN
  _errorcode:=mouseNoError;

  { check if previous status was saved }
  IF ( _savestatebuffer<>NIL ) THEN
  BEGIN

    { restore mouse driver status }
    r.ax:=$0017;
    r.dx:=ofs(_savestatebuffer^);
    r.es:=seg(_savestatebuffer^);
    intr($33,r);

    { release allocated memory }
    freemem(_savestatebuffer,_savestatebuffersize);
    _savestatebuffer:=NIL;
  END;
END;

{
  procedure    : ShowMouse
  parameters    : none
  result    : none

  Increases the internal counter of the mouse-driver. If the count is above
  zero, the mousepointer is visible.
}
PROCEDURE ShowMouse;ASSEMBLER;
ASM
    MOV    AX,0001h
    INT    33h
END;

{
  procedure    : HideMouse
  parameters    : none
  result    : none

  Decreases the internal counter of the mouse-driver. If the count is below
  or equal zero, the mousepointer will be hidden.
}
PROCEDURE HideMouse;ASSEMBLER;
ASM
    MOV    AX,0002h
    INT    33h
END;

{
  procedure    : LocateMouse
  parameters    : x,y:WORD
  result    : none

  Locates the mouspointer at location (x,y) on the screen. The upper left
  corner is given by (0,0) and the coordinates are measured in pixels.
}
PROCEDURE LocateMouse(x,y:WORD);ASSEMBLER;
ASM
    MOV    AX,0004h
    MOV    CX,[x]
    MOV    DX,[y]
    INT    33h
END;

{
  function    : GetMouseInfo
  parameters    : VAR m:MouseRecord
  result    : WORD

  Request the current mouse position, button status and button count. The
  data are stored in MouseRecord m. Returns the current status of the
  buttons.
}
FUNCTION GetMouseInfo(VAR m:MouseRecord):WORD;ASSEMBLER;
ASM
    MOV    AX,0003h
    INT    33h
    LES    DI,m
    MOV     MouseRecord[DI].x,CX
    MOV    MouseRecord[DI].y,DX
    MOV    MouseRecord[DI].count,01h
    MOV    MouseRecord[DI].button,BX
    MOV    AX,BX
END;

{
  function    : GetMousePressInfo
  parameters    : button:WORD; VAR m:MouseRecord
  result    : WORD

  Requests the current status of all mouse-buttons, the number of presses
  and the position of the last press of the requested mouse button. The
  information is stored in MouseRecord m. Returns the current status of
  the mouse buttons.
}
FUNCTION GetMousePressInfo(button:WORD;VAR m:MouseRecord):WORD;ASSEMBLER;
ASM
    MOV    AX,0005h
    MOV    BX,[button]
    SHR    BX,1
    INT    33h
    LES    DI,m
    MOV    MouseRecord[DI].button,AX
    MOV    MouseRecord[DI].count,BX
    MOV    MouseRecord[DI].x,CX
    MOV    MouseRecord[DI].y,DX
END;

{
  function    : GetMouseReleaseInfo
  parameters    : button:WORD; VAR m:MouseRecord
  result    : WORD

  Requests the current status of all mouse-buttons, the number of releases
  and the posiotion of the last release of the requested mouse button. The
  information is stored in MouseRecord m. Returns the current status of
  the mouse button.
}
FUNCTION GetMouseReleaseInfo(button:WORD; VAR m:MouseRecord):WORD;ASSEMBLER;
ASM
    MOV    AX,0006h
    MOV    BX,[button]
    SHR    BX,1
    INT    33h
    LES    DI,m
    MOV    MouseRecord[DI].button,AX
    MOV    MouseRecord[DI].count,BX
    MOV    MouseRecord[DI].x,CX
    MOV    MouseRecord[DI].y,DX
END;

{
  procedure    : SetLimits
  parameters    : xtop,ytop,xbottom,ybottom:WORD
  result    : none

  Limits the pointer display area to the rectangle given by (xtop,ytop)-
  (xbottom,ybottom). Note that (0,0) is assumed to be de upper left corner
  and that the coordinates are measured in pixels.
}
PROCEDURE SetLimits(xtop,ytop,xbottom,ybottom:WORD);ASSEMBLER;
ASM
    { set horizontal limits }
    MOV    AX,0007h
    MOV    CX,[xtop]
    MOV    DX,[xbottom]
    INT    33h
    { set vertical limits }
    MOV    AX,0008h
    MOV    CX,[ytop]
    MOV    DX,[ybottom]
    INT    33h
END;

{
  procedure    : SetGraphPointer
  parameters    : xhspot,yhspot:WORD; VAR imagebuffer
  result    : none

  Defines a new pointer shape in graphics mode. The pointer shape is stored
  in imagebuffer, a 64-byte buffer. The first 32-bytes contain a bit mask
  that is ANDed with the screen image. The last 32-byte contain a bit mask
  that is XORed with the screen image.

  The hot-spot is defined relative from the upper left corner of the mouse-
  pointer image (coordinate (0,0) ) and measured in pixels. Each pixel-
  offset must be within the range -16..16. In display modes 4 and 5 (320x200
  graphics) the offset must be an even number.
}
PROCEDURE SetGraphPointer(xhspot,yhspot:WORD; VAR imagebuffer);ASSEMBLER;
ASM
    MOV    AX,0009h
    MOV    BX,[xhspot]
    MOV    CX,[yhspot]
    MOV    DX,SEG imagebuffer
    MOV    ES,DX
    MOV    DX,OFFSET imagebuffer
    INT    33h
END;

{
  procedure    : SetUserEventHandler
  parameters    : VAR hUser:UserEventHandler
  result    : none

  Installs a user-defined eventhandler. This is a function wich is called
  whenever the state of the mouse complies to the given mask. Both handler-
  function and mask are defined in the UserEventHandler-record.

  The bitmask is interpreted as follows:

  bit        significance (if set)

  0             mouse movement
  1        left button pressed
  2        left button released
  3        right button pressed
  4        right button released
  5        center button pressed
  6        center button released
  7-15        reserved (0)

  The user-defined eventhandler is called as a normal far function with
  the registers set up as follows.

  AX        mouse event flags
  BX        button state (a mbXXXX-value)
  CX        horizontal x-coordinate
  DX        vertical y-coordinate
  SI        last raw vertical mickey count
  DI        last raw horizontal mickey count
  DS        mouse driver datasegment

  Note that bits that do not generate a call to the user-defined event
  handler are still reported in AX.

  One problem arising with a user-defined handler is to acces the global
  data from within the handler-function. This can be done by the following
  code.

    PUSH    DS
    PUSH    AX

    MOV    AX,SEG identifier
    MOV    DS,AX

    ...

    POP    AX
    POP    DS

  Where identifier is the name of a global variable. Remember that youre
  program can have different data-segments (eg. data of a unit are stored
  in a different segment then data of the main source file).
}
PROCEDURE SetUserEventHandler(VAR hUser:UserEventHandler);ASSEMBLER;
ASM
    LES    DI,hUser
    MOV    AX,WORD PTR UserEventHandler[DI+2].handler
    MOV    DX,WORD PTR UserEventHandler[DI].handler
    MOV    CX,WORD PTR UserEventHandler[DI].mask
    MOV    ES,AX
    MOV    AX,000Ch
    INT    33h
END;

{
  procedure    : SwapUserEventHandler
  parameters    : VAR hUser:UserEventHandler
  result    : none

  Swaps the currently active user-eventhandler for a new user-eventhandler
  defined in the UserEventHandler-record hUser. The old handler and its
  mask will be returnd in hUser. For the description of user-eventhandlers
  the user is referred to the procedure SetUserEventHandler.

  WARNING: contents of hUser is not preserved!
}
PROCEDURE SwapUserEventHandler(VAR hUser:UserEventHandler);ASSEMBLER;
ASM
    LES    DI,hUser
    MOV    AX,WORD PTR UserEventHandler[DI+2].handler
    MOV    DX,WORD PTR UserEventHandler[DI].handler
    MOV    CX,WORD PTR UserEventHandler[DI].mask
    MOV    ES,AX
    MOV    AX,0014h
    INT    33h

    MOV    AX,ES
    LES    DI,hUser
    MOV    WORD PTR UserEventHandler[DI+2].handler,AX
    MOV    WORD PTR UserEventHandler[DI].handler,DX
    MOV    WORD PTR UserEventHandler[DI].mask,CX
END;

{
  ------------------------------------------------------------------------

        Implementation EMS Driver (EMS 3.0)

  ------------------------------------------------------------------------
}

CONST
  EMSDriverName        :STRING[8]='EMMXXXX0';

{
  procedure    : InitEMS
  parameters    : none
  result    : none

  Initializes the EMS API-functions. This is done by first establishing
  the fact that EMS is available and setting the global boolean EMSAvail.
}
PROCEDURE InitEMS;ASSEMBLER;
ASM
    PUSH    DS

    { get adress of interrupt vector 67h }
    MOV    AL,67h
    MOV    AH,35h
    INT    21h

    { ES:BX = handler adress }
    { assume driver is loaded at ES:0000h }
    { name driver is located at ES:000Ah }
    MOV    DI,000Ah

    { load compare string and skip length byte }
    LEA    SI,EMSDriverName
    INC    SI

    { load count register }
    MOV    CX,8
    CLD
    REP    CMPSB
    JNZ    @Exit

    { check if driver and hardware is available }
    MOV    AH,40h
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit

    { get page frame adress }
    MOV    AH,41h
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    MOV    WORD PTR [EMSPageFrameAdress+2],BX

    MOV    [EMSAvail],TRUE

    MOV    AH,42h
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    MOV    [EMSTotalPages],DX
    MOV    [EMSFreePages],BX

@Exit:    POP    DS
END;

{
  procedure    : GetVersion
  parameters    : VAR num,dec:BYTE
  result    : none

  Returns the version of the EMS-driver. The integer part is returned in
  num and the decimal part in dec.
}
PROCEDURE EMSGetVersion(VAR num,dec:BYTE);ASSEMBLER;
ASM
    { get version in BCD-code }
    MOV    AH,46h
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    { copy version number }
    MOV    AH,AL
    { create decimal number in AL }
    AND    AL,0Fh
    { create integer number in AH }
    AND    AH,0F0h
    SHR    AH,4
    { store result in parameters }
    LES    DI,num
    MOV    BYTE PTR [DI],AH
    LES    DI,dec
    MOV    BYTE PTR [DI],AL

    POP    BP
    RET    TYPE num + TYPE dec

@Exit:  LES    DI,num
    MOV    BYTE PTR [DI],00h
    LES    DI,dec
    MOV    BYTE PTR [DI],00h
END;

{
  function    : AllocEMS
  parameters    : VAR handle:WORD; numpages:WORD
  result    : BOOLEAN

  Allocates numpages (>0) of EMS-memory and returns the handle to it. If
  succesfull this function will return TRUE. Otherwise, EMSErrorCode will
  be set to a value indicating the error.
}
FUNCTION AllocEMS(VAR handle:WORD; numpages:WORD):BOOLEAN;ASSEMBLER;
ASM
    { allocate numpages of EMS-memory }
    MOV    AH,43h
    MOV    BX,[numpages]
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    { store handle }
    LES    DI,handle
    MOV    WORD PTR [DI],DX
    MOV    AL,TRUE

    POP    BP
    RET    TYPE handle + TYPE numpages

@Exit:    MOV    AL,FALSE
END;

{
  function    : FreeEMS
  parameters    : VAR handle:WORD
  result    : BOOLEAN

  Free's the EMS-memory allocated by AllocEMS. If succesfull this function
  will return TRUE and the handle is no longer valid. Otherwise EMSError-
  Code will be set to a value indiciting the error.
}
FUNCTION FreeEMS(VAR handle:WORD):BOOLEAN;ASSEMBLER;
ASM
    { free handle }
    MOV    AH,45h
    LES    DI,handle
    MOV    DX,WORD PTR [DI]
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    MOV    AL,TRUE

    POP    BP
    RET    TYPE handle

@Exit:    MOV    AL,FALSE
END;

{
  function    : MapEMS
  parameters    : srcPage:WORD; destPage:BYTE; VAR handle:WORD
  result    : BOOLEAN

  Maps destPage, belonging to the given handle, into physical accessible
  base memory. Since the base-memory is divided in 4 pages of 16 kB each,
  the value of destPage can only range from 0..3. The value of srcPage
  can range form 0..n-1 where n is the total number of pages associated
  with the given handle. This function will return TRUE if succesful or
  FALSE in case of an error.
}
FUNCTION MapEMS(srcPage:WORD; destPage:BYTE; VAR handle:WORD):BOOLEAN;ASSEMBLER;
ASM
    { map scrPage -> destPage }
    LES    DI,handle
    MOV    DX,WORD PTR [DI]
    MOV    BX,[srcPage]
    MOV    AL,[destPage]
    MOV    AH,44h
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    MOV    AL,TRUE

    POP    BP
    RET    TYPE srcPage + TYPE destPage + TYPE handle

@Exit:    MOV    AL,FALSE
END;

{
  function    : EMSGetFreePages
  parameters    : none
  result    : WORD

  Returns the number of allocatable pages EMS-memory. This is equivalent
  to the MemAvail-function for base-memory. If this function returns
  zero, either an error has occured or there are allocatable pages left.
  The user must verify this by checking the value of EMSErrorCode. If
  succesful the value of EMSFreePages is updated.
}
FUNCTION EMSGetFreePages:WORD;ASSEMBLER;
ASM
    { obtain number of free pages }
    MOV    AH,42h
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    MOV    [EMSFreePages],BX
    MOV    AX,BX

    RET

@Exit:    XOR    AX,AX
END;

{
  function    : EMSGetHandlePages
  parameters    : VAR handle:WORD
  result    : WORD

  Returns the number of allocated pages associated with the given handle.
  If this function returns zero, the user must check EMSErrorCode to
  see if an error has occured. If no error occures and the function returns
  zero, then the handle has no associated EMS-pages.
}
FUNCTION EMSGetHandlePages(VAR handle:WORD):WORD;ASSEMBLER;
ASM
    { obtain number of pages associated with handle }
    MOV    AH,4Ch
    LES    DI,handle
    MOV    DX,WORD PTR [DI]
    INT    67h
    MOV    [EMSErrorCode],AH
    CMP    AH,00h
    JNE    @Exit
    MOV    AX,BX

    POP    BP
    RET    TYPE handle

@Exit:    XOR    AX,AX
END;

{
  ------------------------------------------------------------------------

        Implementation XMS Driver (XMS 3.0)

  ------------------------------------------------------------------------
}

CONST
  XMSControll        :POINTER=NIL;
  XMS_HMAexist        :BOOLEAN=FALSE;

{
  procedure    : InitXMS
  parameters    : none
  result    : none

  Initializes the XMS-driver. If XMS is available then the boolean XMSAvail
  will be set to TRUE.
}
PROCEDURE InitXMS;ASSEMBLER;
ASM
    { check for XMS-driver }
    MOV    AX,4300h
    INT    2Fh
    CMP    AL,80h
    JE    @XMSfound

    RET

@XMSfound:
    { request adress XMS-controll function }
    MOV    AX,4310h
    INT    2Fh
    MOV    WORD PTR [XMSControll],BX
    MOV    WORD PTR [XMSControll+2],ES

    { set global variable XMSAvail }
    MOV    [XMSAvail],TRUE
END;

{
  procedure    : XMSGetVersion
  parameters    : VAR num,dec:BYTE
  result    : none

  Returns the XMS-drivers version number. The integer part is returned in
  num, the decimal part in dec. If an error occures the number returned
  will be zero and the user must check the value of XMSErrorCode
}
PROCEDURE XMSGetVersion(VAR num,dec:BYTE);ASSEMBLER;
ASM
    { no errors possible }
    MOV    [XMSErrorCode],00h

    { request version number }
    MOV    AH,00h
    CALL    [XMSControll]
    MOV    [XMS_HMAexist],DL

    { decode BCD-number }
    MOV    BX,AX

    { decode decimal part }
    MOV    AH,AL
    AND    AH,0F0h
    SHR    AH,2
    MOV    CL,AH
    SHR    AH,2
    ADD    CL,AH
    ADD    CL,AH
    AND    AL,0Fh
    ADD    CL,AL

    { decode integer part }
    MOV    BL,BH
    AND    BH,0F0h
    SHR    BH,2
    MOV    CH,BH
    SHR    BH,2
    ADD    CH,BH
    ADD    CH,BH
    AND    BL,0Fh
    ADD    CH,BL

    { store version number }
    LES    DI,num
    MOV    BYTE PTR [DI],CH
    LES    DI,dec
    MOV    BYTE PTR [DI],CL
END;

{
  function    : XMSGetMaxBlock
  parameters    : none
  result    : WORD

  Returns the maximum allocatable block of memory. If succesful the value
  of XMSFreeMemory and XMSMaxBlock is updated. Otherwise this funciotn
  returns zero. The amount returned is measured in Kb.
}
FUNCTION XMSGetMaxBlock:WORD;ASSEMBLER;
ASM
    { query free extended memory }
    MOV    AH,08h
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    { update globals }
    MOV    [XMSFreeMemory],DX
    MOV    [XMSMaxBlock],AX

    RET

@Error:    MOV    [XMSErrorCode],BL
END;

{
  function    : AllocXMS
  parameters    : VAR handle:WORD; sizeKB:WORD
  returns    : BOOLEAN

  This function will try to allocate a XMS-block of sizeKB Kb. On succes
  the value of handle will be set to the newly acquired XMS-handle and the
  function will return TRUE. Otherwise, handle will be set to zero and the
  function returns FALSE.

  Note: XMS is allocated in chuncks of 16 Kb. So allocation 1 Kb means
    that the total free XMS decreases with 16 Kb
}
FUNCTION AllocXMS(VAR handle:WORD; sizeKB:WORD):BOOLEAN;ASSEMBLER;
ASM
    { load adress of handle }
    LES    DI,handle

    { request XMS-block }
    MOV    AH,09h
    MOV    DX,[sizeKB]
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    { store handle and return TRUE }
    MOV    WORD PTR [DI],DX
    MOV    AL,TRUE

    POP    BP
    RET    TYPE handle + TYPE sizeKB

@Error: MOV    [XMSErrorCode],BL
    MOV    WORD PTR [DI],AX
END;

{
  function    : FreeXMS
  parameters    : VAR handle:WORD
  result    : BOOLEAN

  This function will free a previous allocated block of XMS-memory. It
  will return TRUE on succes or FALSE otherwise. If succesful the value
  of handle is no longer valid and will be set to zero!
}
FUNCTION FreeXMS(VAR handle:WORD):BOOLEAN;ASSEMBLER;
ASM
    { load adress of handle }
    LES    DI,handle

    { free XMS-block }
    MOV    AH,0Ah
    MOV    DX,WORD PTR [DI]
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    { set handle to zero and return TRUE }
    MOV    WORD PTR [DI],0000h
    MOV    AL,TRUE

    POP    BP
    RET    TYPE handle

@Error: MOV    [XMSErrorCode],BL
END;

{
  function    : MoveXMS
  parameters    : VAR mvData:XMSMoveStruct
  result    : BOOLEAN

  This function will move the contents of an XMS-handle to another area
  in memory. The function will return TRUE on succes of FALSE otherwise.

  The parameter mvData of type XMSMoveStruct contains the information
  needed for the move.

  mvData.length        32-bit number of bytes to transfer
  mvData.hSource    XMS-handle of source-block
  mvData.offsetSource    32-bit offset into the source-block
  mvData.hDest        XMS-handle of dest-block
  mvData.offsetDest    32-bit offset into the dest-block

  Note: if hSource of hDest is set to 0000h then the corresponding 32-bit
    offset is interpreted as a segment:offset adress into real-mode
    accesible memory (up to 1 Mb)
}
FUNCTION MoveXMS(VAR mvData:XMSMoveStruct):BOOLEAN;ASSEMBLER;
ASM
    { load mvData }
    LDS    SI,mvData
    MOV    AH,0Bh
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    POP    BP
    RET    TYPE mvData

@Error: MOV    [XMSErrorCode],BL
END;

{
  function    : ReAllocXMS
  parameters    : VAR handle:WORD; newsizeKB:WORD
  result    : BOOLEAN

  This function will try to reallocate the XMS-block so that it's size
  will become newsizeKB. If the new block is smaller than the old one,
  all data at the upper end of the block are lost. The function will
  return TRUE on succes or FALSE otherwise.
}
FUNCTION ReAllocXMS(VAR handle:WORD; newsizeKB:WORD):BOOLEAN;ASSEMBLER;
ASM
    { load handle }
    LES    DI,handle
    MOV    DX,WORD PTR [DI]
    MOV    AH,0Fh
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    POP    BP
    RET    TYPE handle + TYPE newsizeKB

@Error:    MOV    [XMSErrorCode],BL
END;

{
  function    : XMSGetBlockSize
  parameters    : VAR handle:WORD
  result    : WORD

  This function will return the size in Kb of the allocated XMS-block
  corresponding to the given handle. It will return zero in case of an
  error (since no XMS-block of zero Kb can be allocated).
}
FUNCTION XMSGetBlockSize(VAR handle:WORD):WORD;ASSEMBLER;
ASM
    { load handle }
    LES    DI,handle

    { request block information }
    MOV    AH,0Fh
    MOV    DX,WORD PTR [DI]
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    { return size XMS-block in Kb }
    MOV    AX,DX

    POP    BP
    RET    TYPE handle

@Error: MOV    [XMSErrorCode],BL
END;

VAR
  mvData    :XMSMoveStruct;

{
  procedure    : RealToXMS
  parameters    : VAR source; VAR hDest:WORD; ofs,cnt:LONGINT
  result    : none

  Moves cnt bytes from source in real memory to XMS-memory corresponding
  to the handle hDest. The data will be written in XMS-memory starting
  from offset ofs.
}
PROCEDURE RealToXMS(VAR source; VAR hDest:WORD; ofs,cnt:LONGINT);ASSEMBLER;
ASM
    PUSH    DS

    { fill XMSMoveStruct }
    MOV    AX,WORD [cnt]
    MOV    DX,WORD [cnt+2]
    MOV    WORD [mvData.length],AX
    MOV    WORD [mvData.length+2],DX

    MOV    WORD [mvData.hSource],0000h
    MOV    AX,WORD [source]
    MOV    DX,WORD [source+2]
    MOV    WORD [mvData.offsetSource],AX
    MOV    WORD [mvData.offsetSource+2],DX

    LES    DI,hDest
    MOV    AX,WORD PTR [DI]
    MOV    WORD [mvData.hDest],AX
    MOV    AX,WORD [ofs]
    MOV    DX,WORD [ofs+2]
    MOV    WORD [mvData.offsetDest],AX
    MOV    WORD [mvData.offsetDest+2],DX

    { load XMSMoveStruct }
    LEA    SI,XMSMoveStruct PTR mvData
    MOV    AH,0Bh
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    POP    DS

    MOV    SP,BP
    POP    BP
    RET    TYPE source + TYPE hDest + TYPE ofs + TYPE cnt

@Error:    MOV    [XMSErrorCode],BL

    POP    DS
END;

{
  procedure    : XMSToReal
  parameters    : VAR hSource:WORD; ofs:LONGINT; VAR dest; cnt:LONGINT
  result    : none

  Moves cnt bytes from XMS-memory corresponding to the handle hSource
  starting at offset ofs to source in real memory.
}
PROCEDURE XMSToReal(VAR hSource:WORD; ofs:LONGINT; VAR dest; cnt:LONGINT);ASSEMBLER;
ASM
    PUSH    DS

    { fill XMSMoveStruct }
    MOV    AX,WORD [cnt]
    MOV    DX,WORD [cnt+2]
    MOV    WORD [mvData.length],AX
    MOV    WORD [mvData.length+2],DX

    MOV    WORD [mvData.hDest],0000h
    MOV    AX,WORD [dest]
    MOV    DX,WORD [dest+2]
    MOV    WORD [mvData.offsetDest],AX
    MOV    WORD [mvData.offsetDest+2],DX

    LES    DI,hSource
    MOV    AX,WORD PTR [DI]
    MOV    WORD [mvData.hSource],AX
    MOV    AX,WORD [ofs]
    MOV    DX,WORD [ofs+2]
    MOV    WORD [mvData.offsetSource],AX
    MOV    WORD [mvData.offsetSource+2],DX

    { load XMSMoveStruct }
    LEA    SI,XMSMoveStruct PTR mvData
    MOV    AH,0Bh
    CALL    [XMSControll]

    { test for error }
    CMP    AX,0000h
    JE    @Error

    POP    DS

    POP    BP
    RET    TYPE hSource + TYPE ofs + TYPE dest + TYPE cnt

@Error:    MOV    [XMSErrorCode],BL

    POP    DS
END;

END.